
import Test.QuickCheck
import Data.List
import System

----------------------------------------------------------------------------
-- 1.

-- a.

addresses :: String -> [String]
addresses s = [w | w <- words s, '@' `elem` w]

{-
-- alternatively:
addresses = concat
          . map (filter ('@' `elem`))
          . map words
          . lines
-}

-- b.

mailall :: IO ExitCode
mailall =
  do s <- readFile "addresses"
     system ("mail " ++ unwords (addresses s) ++ " < message")

-- c.

printList :: IO ()
printList =
  do s <- readFile "addresses"
     putStr (process s)

process :: String -> String
process s = unlines (sort [line l | l <- lines s])
 where
  line l = pad 24 (surname ++ ", " ++ unwords forenames) ++ email
   where
    ws        = words l
    email     = last ws
    name      = [w | w <- ws, not ('@' `elem` w) ]
    surname   = last name
    forenames = init name 

  pad n s = s ++ replicate (n-length s) ' '

----------------------------------------------------------------------------
-- 2.

data Table
  = Decision String 
  | Question String Table Table
 deriving ( Eq, Show )

-- a.

example :: Table
example =
  Question "Does it live in water"
    (Decision "It is an angel fish")
    (Question "Is it black"
	(Decision "It is an ant")
	(Decision "It is a zebra"))

-- b.

decide :: Table -> IO ()
decide (Decision s) =
  do putStrLn s

decide (Question q y n) =
  do putStr (q ++ "? ")
     ans <- getLine
     case ans of
       "y" -> decide y
       "n" -> decide n
       _   -> decide (Question q y n)

-- c.

facts :: Facts
facts =
  [ ( "It is an ant"
    , [ ("Is it smaller than a pen",True)
      , ("Is it black",True)
      , ("Does it live in water",False)
      ]
    )
  , ( "It is a zebra"
    , [ ("Is it smaller than a pen",False)
      , ("Does it live in water",False)
      , ("Is it striped",True)
      , ("Is it black",False)
      ]
    )
  , ("It is an angel fish"
    , [ ("Is it smaller than a pen",True)
      , ("Is it striped",True)
      , ("Is it black",False)
      , ("Does it live in water",True)
      ]
    )
  ]

type Facts
  = [(String,[(String,Bool)])]

-- d.

restrict :: String -> Bool -> Facts -> Facts
restrict q a facts =
  [ (concl,delete (q,a) answers)
  | (concl,answers) <- facts
  , (q, not a) `notElem` answers
  ]

-- e.

table :: Facts -> Table
table [(concl,_)] = Decision concl
table facts       = Question q (table (restrict q True facts))
		               (table (restrict q False facts))
 where
  qs = questions facts
  q  = best qs facts

questions :: Facts -> [String]
questions facts =
  nub [ q
      | (concl,answers) <- facts,
        (q,a) <- answers ]

quality :: String -> Facts -> Int
quality q facts =
  length (restrict q True facts) `max`
  length (restrict q False facts)

best :: [String] -> Facts -> String
best qs facts = q
 where
   (_,q):_ = sort [(quality q facts,q) | q <- qs]

----------------------------------------------------------------------------
-- 3.

-- a.

ordered :: Ord a => [a] -> Bool
ordered (x:y:xs) = x <= y && ordered (y:xs)
ordered _        = True

{-
-- alternatively:
ordered xs = and (zipWith (<=) xs (drop 1 xs))
-}

-- b.

isPermutation :: Eq a => [a] -> [a] -> Bool
isPermutation []     ys = null ys
isPermutation (x:xs) ys = x `elem` ys && isPermutation xs (ys \\ [x])

-- c.

prop_SortPermutes :: [Int] -> Bool
prop_SortPermutes xs =
  sort xs `isPermutation` xs

prop_SortOrders :: [Int] -> Bool
prop_SortOrders xs =
  ordered (sort xs)

-- d.

permutation :: Eq a => [a] -> Gen [a]
permutation [] = do return []
permutation xs = do x   <- elements xs -- alternatively: x <- oneof [ return x | x <- xs ]
                    xs' <- permutation (xs \\ [x])
                    return (x:xs')

prop_Permutation :: [Int] -> Property
prop_Permutation xs =
  forAll (permutation xs) $ \ys ->
    xs `isPermutation`  ys

-- e.

prop_SortPermutationSame :: [Int] -> Property
prop_SortPermutationSame xs =
  forAll (permutation xs) $ \ys ->
    sort xs == sort ys

----------------------------------------------------------------------------
-- 4.

data Pos
  = Pos [Field] [Field]
 deriving ( Eq, Show )

type Field
  = Integer

-- a.

{-
(1): If Pos xs os, then no number may occur in both xs and os

(2): If Pos xs os, then all numbers in xs and os must lie between 1 and 9
-}

-- b.

validPos :: Pos -> Bool
validPos (Pos xs os) = and [ x `notElem` os | x <- xs ]
                    && and [ 1 <= n && n <= 9 | n <- xs ++ os ]
                    
-- c.

vacant :: Pos -> [Field]
vacant (Pos xs os) = [ n | n <- [1..9], n `notElem` xs++os ]                    

-- d.

play :: Field -> Pos -> Pos
play n (Pos xs os) = Pos (n:xs) os

-- e.

instance Arbitrary Pos where
  arbitrary =
    do n  <- choose (0,9::Int)
       ps <- sequence (repeat (choose (1,9)))
       let ps' = nub ps
       bs <- sequence [ arbitrary | i <- [1..n] ]
       return (Pos [p | (False,p) <- bs `zip` ps'] [p | (True,p) <- bs `zip` ps'])

prop_PlayValid pos mv =
  mv `elem` vacant pos ==>
    validPos (play mv pos)

-- f.

won :: Pos -> Bool
won (Pos xs os) =
  or
  [ xs `contains` line 
  | line <- [ [p,p+1,p+2] | p <- [1,4,7] ]
         ++ [ [p,p+3,p+6] | p <- [1,2,3] ]
         ++ [ [1,5,9], [3,5,7] ]
  ]

contains :: Eq a => [a] -> [a] -> Bool
xs `contains` ys = and [ y `elem` xs | y <- ys ]

-- g.

opposite :: Pos -> Pos
opposite (Pos xs os) = Pos os xs

-- g'.

score :: Pos -> Integer
score pos
  | won pos            = 1
  | won (opposite pos) = -1
  | null ps            = 0
  | otherwise          = maximum [ - score (opposite (play p pos)) | p <- ps ]
 where
  ps = vacant pos

-- h.

bestMove :: Pos -> Field
bestMove pos = p
 where
  (sc,p) : _ = sort [ (score (play p pos),p) | p <- vacant pos ]

----------------------------------------------------------------------------
